LBHelpSearcher

 
' Credit for this program goes to members of the Liberty BASIC
' community, most especially Alyce Watson and Stefan Pendl.
' Snippets absorbed and regurgitated by Janet Terra
 
' Get the path to the Html Help Files - Thanks to Stefan Pendl
    LBModulePath$ = GetModuleFileName$() ' Path to liberty44.exe
    LBHelpPath$ = GetHelpPath$(LBModulePath$) ' Path to Html Help Files
    LBHelpIndex$ = LBHelpPath$;"libe3mnn.htm" ' The LB Index file
 
' Fill an array with command references
    dim cmd$(7)
    cmd$(1) = "Commands A - C";chr$(0);LBHelpPath$;"LIBE2CO3.HTM"
    cmd$(2) = "Commands D - F";chr$(0);LBHelpPath$;"LIBE2M5I.HTM"
    cmd$(3) = "Commands G - K";chr$(0);LBHelpPath$;"LIBE2VMZ.HTM"
    cmd$(4) = "Commands L - M";chr$(0);LBHelpPath$;"LIBE3BFX.HTM"
    cmd$(5) = "Commands N - P";chr$(0);LBHelpPath$;"LIBE3HRK.HTM"
    cmd$(6) = "Commands R - S";chr$(0);LBHelpPath$;"LIBE3UER.HTM"
    cmd$(7) = "Commands T - Z";chr$(0);LBHelpPath$;"LIBE40QF.HTM"
 
' Define a struct to hold window dimensions - Thanks to Bill Beasley
    struct rcClient, _
        xLeft as long, _
        yUpper as long, _
        xRight as long, _
        yLower as long
 
' The GUI
    WindowWidth = 800
    WindowHeight = 600
    UpperLeftX = int((DisplayWidth - WindowWidth) / 2)
    UpperLeftY = int((DisplayHeight - WindowHeight) / 2)
 
    stylebits #main.cmd, 0, _WS_BORDER, 0, 0
    graphicbox #main.cmd, 600, 10, 180, 80
    textbox #main.srch, 600, 10, 160, 24
    stylebits #main.go, _BS_DEFPUSHBUTTON, 0, 0, 0
    button #main.go, ">>", [search], UL, 760, 110, 30, 24
    listbox #main.mtch, matchFiles$(), [DisplayHtml], 600, 140, 190, 100
    graphicbox #main.atl, 10, 10, 575, 550
    open "Search LB Help HTML Files" for window as #main
 
' Relocate controls
    call GetClientRect hwnd(#main)
    xMain = rcClient.xLeft.struct
    wMain = rcClient.xRight.struct
    yMain = rcClient.yUpper.struct
    tMain = rcClient.yLower.struct
    #main.atl "locate 10 10 575 ";tMain - 20
    #main.cmd "locate ";wMain - 200;" 10 190 80"
    #main.cmd "down; backcolor buttonface"
    call CommandReferences
    #main.cmd "flush"
    #main.srch "!locate ";wMain - 200;" 110 160 24"
    #main.go "!locate ";wMain - 40;" 110 30 24"
    #main.mtch "locate ";wMain - 200;" 140 190 ";tMain - 150
    #main "font verdana 10"
    #main.go "!font verdana 10 bold"
    #main "refresh"
    #main.mtch "singleclickselect"
    #main "trapclose [quit]"
    #main.cmd "when mouseMove [htmlCursor]"
    #main.cmd "when leftButtonUp [DisplayAlphCommands]"
 
' Convert graphicbox to browser display using ATL dll - Thanks to Alyce Watson and Stefan Pendl
    hMain = hwnd(#main)
    hBrowserContainer = hwnd(#main.atl)
    open "atl" for dll as #atl
    calldll #atl, "AtlAxWinInit", _
        ATLinitialized as long
    styleATL = _WS_CHILD or _WS_VISIBLE or _WS_VSCROLL or _WS_HSCROLL
    calldll #user32, "GetWindowLongA", _
        hMain as ulong, _
        _GWL_HINSTANCE as long, _
        hInst as ulong
    hATL = CreateWindowExA(LBHelpIndex$, styleATL, hBrowserContainer, hInst)
    htmlFile$ = LBHelpIndex$
 
' Disable search textbox while html files being read
    #main.srch "!Disable"
 
' Use files() command to find number of Html Help Files
    dim info$(10, 10)
    files LBHelpPath$, info$()
    nHtmlFiles = val(info$(0, 0)) ' Total number of LB Html Help Files
 
' Searchbox phrases
    lp$ = "Loading . . . "
    LoadingPhrase$ = ""
    for i = 1 to nHtmlFiles / 15
        LoadingPhrase$ = LoadingPhrase$;lp$
    next i
    sp$ = "Searching . . . "
    SearchingPhrase$ = ""
    for i = 1 to nHtmlFiles / 15
        SearchingPhrase$ = SearchingPhrase$;sp$
    next i
 
' Store the file names in an array
    dim htmlFiles$(nHtmlFiles)
    for i = 1 to nHtmlFiles
        htmlFiles$(i) = info$(i, 0)
    next i
 
' Store contents of each file in htmlFiles$()
    for i = 1 to nHtmlFiles
        html$ = LBHelpPath$;htmlFiles$(i)
        open html$ for input as #1
            contents$ = input$(#1, LOF(#1))
            htmlFiles$(i) = htmlFiles$(i);chr$(0);contents$
        close #1
    next i
 
' Store the title of each file in htmlFiles$()
    n = 0
    for i = 1 to nHtmlFiles
        n = n + 1
        if n mod 25 = 0 then
            #main.srch right$(LoadingPhrase$, n)
        end if
        htmlTitle$ = ExtractHtmlTitle$(htmlFiles$(i))
        htmlFiles$(i) = htmlTitle$;chr$(0);htmlFiles$(i)
    next i
 
' htmlFiles$() format
'   htmlTitle$;chr$(0);htmlFilePath$;chr$(0);htmlContents$
 
' Alphabetize by title
    sort htmlFiles$(), 1, nHtmlFiles
 
' Define an array to hold html files containing search item
    dim matchFiles$(nHtmlFiles)
    for i = 1 to nHtmlFiles
        matchFiles$(i) = htmlFiles$(i)
    next i
 
' Load the match listbox
    #main.mtch "reload"
 
' Enable search textbox
    #main.srch "Search for ..."
    #main.srch "!enable"
 
' Load pointing hand cursor - Thanks to Gordon Sweet
    hCmd = hwnd(#main.cmd)
    call SetClass hCmd
    nCursor = 32649
    hCursor = LoadCursor(nCursor)
wait
 
[DisplayAlphCommands]
    if cmd <> 0 then
        htmlFile$ = word$(cmd$(cmd), 2, chr$(0))
        call DestroyWindow hATL
        hATL = CreateWindowExA(htmlFile$, styleATL, hBrowserContainer, hInst)
    end if
wait
 
[DisplayHtml]
    #main.mtch "selectionindex? nPage"
    htmlFile$ = LBHelpPath$;word$(matchFiles$(nPage), 2, chr$(0))
    call DestroyWindow hATL
    hATL = CreateWindowExA(htmlFile$, styleATL, hBrowserContainer, hInst)
wait
 
[search]
    #main.srch "!contents? search$"
    nSearchFiles = FindMatch(nHtmlFiles, search$)
    #main.mtch "reload"
wait
 
[htmlCursor]
    xVar = MouseX
    yVar = MouseY
    cmd = 0
    select case
        case yVar > 30 and yVar < 42
            select case
                case xVar > 37 and xVar < 63
                    cmd = 1
                case xVar > 77 and xVar < 103
                    cmd = 2
                case xVar > 117 and xVar < 143
                    cmd = 3
            end select
        case yVar > 52 and yVar < 64
            select case
                case xVar > 10 and xVar < 36
                    cmd = 4
                case xVar > 55 and xVar < 83
                    cmd = 5
                case xVar > 100 and xVar < 126
                    cmd = 6
                case xVar > 144 and xVar < 170
                    cmd = 7
            end select
    end select
    if cmd = 0 then
        nCursor = 0
        cursor normal
    else
        nCursor = 32649
        call SetCursor hCursor
    end if
wait
 
[quit]
    call DestroyWindow hATL
    close #atl
    close #main
end
 
function FindMatch(nFiles, search$)
    ct = 0
    redim matchFiles$(nFiles)
    for ii = 1 to nFiles
        contents$ = word$(htmlFiles$(ii), 1, chr$(0));word$(htmlFiles$(ii), 3, chr$(0))
        if instr(upper$(contents$), upper$(search$)) > 0 then
            ct = ct + 1
            matchFiles$(ct) = htmlFiles$(ii)
        end if
    next ii
    FindMatch = ct
end function
 
function GetModuleFileName$()
    nSize = _MAX_PATH + 1
    lpFilename$ = space$(nSize); CHR$(0)
 
    calldll #kernel32, "GetModuleFileNameA", _
        hModule as ulong, _
        lpFilename$ as ptr, _
        nSize as ulong, _
        result as ulong
 
    if result > 0 then
        GetModuleFileName$ = trim$(lpFilename$)
    end if
end function
 
function GetHelpPath$(LBModulePath$)
    pos = 0
    for ii = len(LBModulePath$) to 1 step -1
        if mid$(LBModulePath$, ii, 1) = "\" then
            pos = ii
            exit for
        end if
    next ii
    GetHelpPath$ = left$(LBModulePath$, pos);"lb4help\LibertyBASIC_4_web\html\"
end function
 
function ExtractHtmlTitle$(contents$)
    c1a$ = ""
    c1b$ = ""
    c2$ = ""
    tag1a$ = "<A NAME=";chr$(34)
    tag1b$ = chr$(34);"></A><B>"
    tag2$ = "</B></P>"
    pos1a = 0
    pos1b = 0
    pos2 = 0
    if instr(upper$(contents$), tag1a$) > 0 then
        pos1a = instr(upper$(contents$), tag1a$) + len(tag1a$) + 1
        c1a$ = mid$(contents$, pos1a)
    end if
    if instr(upper$(c1a$), tag1b$) > 0 then
        pos1b = instr(upper$(c1a$), tag1b$) + len(tag1b$)
        c1b$ = mid$(c1a$, pos1b)
    end if
    if instr(upper$(c1b$), tag2$) > 0 then
        pos2 = instr(upper$(c1b$), tag2$) - 1
        ExtractHtmlTitle$ = trim$(left$(c1b$, pos2))
    end if
    if ExtractHtmlTitle$ <> "" then
        exit function
    end if
    tag1$ = "<P><B>"
    tag2$ = "</B></P>"
    pos1 = instr(upper$(contents$), tag1$) + len(tag1$)
    c1$ = mid$(contents$, pos1)
    pos2 = instr(upper$(c1$), tag2$)
    ExtractHtmlTitle$ = left$(c1$, pos2 - 1)
end function
 
sub GetClientRect hControl
    calldll #user32, "GetClientRect", _
        hControl as ulong, _
        rcClient as struct, _
        result as long
end sub
 
function CreateWindowExA(page$, style, hParent, hInst)
    call GetClientRect hwnd(#main)
    wATL = rcClient.xRight.struct - 220
    tMain = rcClient.yLower.struct - 20
    calldll #user32, "CreateWindowExA", _
        _WS_EX_CLIENTEDGE as ulong, _
        "ATLAxWin" as ptr, _
        page$ as ptr, _
        style as ulong, _
        0 as long, _
        0 as long, _
        wATL as long, _
        tMain as long, _
        hParent as ulong, _
        _NULL as ulong, _
        hInst as ulong, _
        _NULL as ulong, _
        CreateWindowExA as ulong
end function
 
sub SetClass hControl
    index = _GCL_HCURSOR or 0
    calldll #user32, "SetClassLongA", _
        hControl as ulong, _
        index as long, _
        0 as long, _
        result as long
end sub
 
sub SetCursor hCursor
    calldll #user32, "SetCursor", _
        hCursor as ulong, _
        result as long
end sub
 
function LoadCursor(nCursor)
    flags = hexdec("8000") or _LR_DEFAULTSIZE
    calldll #user32, "LoadImageA", _
        0 as long, _
        nCursor as long, _
        _IMAGE_CURSOR as long, _
        0 as long, _
        0 as long, _
        flags as long, _
        hCursor as uLong
    call SetCursor hCursor
    LoadCursor = hCursor
end function
 
sub DestroyWindow hATL
    calldll #user32, "DestroyWindow", _
        hATL as ulong, _
        result as long
end sub
 
sub CommandReferences
    #main.cmd "place -10 -10; boxfilled 210 100"
    #main.cmd "font verdana 10 bold; color black"
    t$ = "LB Command References"
    #main.cmd "stringwidth? t$ wdth"
    #main.cmd "place ";int(90 - wdth / 2);" 18"
    #main.cmd "\";t$
    #main.cmd "font verdana 10 underscore; color blue"
    t$ = "A-C"
    #main.cmd "stringwidth? t$ wdth"
    #main.cmd "place ";int(50 - wdth / 2);" 42"
    #main.cmd "\";t$
    t$ = "D-F"
    #main.cmd "stringwidth? t$ wdth"
    #main.cmd "place ";int(90 - wdth / 2);" 42"
    #main.cmd "\";t$
    t$ = "G-K"
    #main.cmd "stringwidth? t$ wdth"
    #main.cmd "place ";int(130 - wdth / 2);" 42"
    #main.cmd "\";t$
    t$ = "L-M"
    #main.cmd "stringwidth? t$ wdth"
    #main.cmd "place ";int(23 - wdth / 2);" 64"
    #main.cmd "\";t$
    t$ = "N-P"
    #main.cmd "stringwidth? t$ wdth"
    #main.cmd "place ";int(68 - wdth / 2);" 64"
    #main.cmd "\";t$
    t$ = "R-S"
    #main.cmd "stringwidth? t$ wdth"
    #main.cmd "place ";int(113 - wdth / 2);" 64"
    #main.cmd "\";t$
    t$ = "T-Z"
    #main.cmd "stringwidth? t$ wdth"
    #main.cmd "place ";int(157 - wdth / 2);" 64"
    #main.cmd "\";t$
    #main.cmd "flush"
end sub